Visual Basic Source Code

home *** CD-ROM | disk | FTP | other *** search

/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / starfi_1 / form1.frm (.txt) next >

Wrap

Visual Basic Form | 1997-09-08 | 11.4 KB | 332 lines

VERSION 4.00 Begin VB.Form Form1 Appearance = 0 'Flat BackColor = &H0000C0C0& BorderStyle = 0 'None Caption = "Form1" ClientHeight = 4815 ClientLeft = 1920 ClientTop = 2640 ClientWidth = 5445 Height = 5220 KeyPreview = -1 'True Left = 1860 LinkTopic = "Form1" ScaleHeight = 4815 ScaleWidth = 5445 ShowInTaskbar = 0 'False Top = 2295 Width = 5565 Begin VB.PictureBox picTitlemsk Appearance = 0 'Flat AutoRedraw = -1 'True AutoSize = -1 'True BackColor = &H80000005& ForeColor = &H80000008& Height = 1440 Left = 2400 Picture = "Form1.frx":0000 ScaleHeight = 94 ScaleMode = 3 'Pixel ScaleWidth = 359 TabIndex = 3 Top = 3180 Visible = 0 'False Width = 5415 End Begin VB.PictureBox picTitle Appearance = 0 'Flat AutoRedraw = -1 'True AutoSize = -1 'True BackColor = &H80000005& ForeColor = &H80000008& Height = 1440 Left = 2280 Picture = "Form1.frx":18CD2 ScaleHeight = 94 ScaleMode = 3 'Pixel ScaleWidth = 359 TabIndex = 2 Top = 1560 Visible = 0 'False Width = 5415 End Begin VB.Timer Timer1 Interval = 20 Left = 0 Top = 1380 End Begin VB.PictureBox picWork Appearance = 0 'Flat AutoRedraw = -1 'True BackColor = &H00000000& DrawWidth = 2 FillColor = &H0000FF00& BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0000FF00& Height = 555 Left = 540 ScaleHeight = 35 ScaleMode = 3 'Pixel ScaleWidth = 59 TabIndex = 1 Top = 1500 Visible = 0 'False Width = 915 End Begin VB.PictureBox picScreen Appearance = 0 'Flat AutoRedraw = -1 'True BackColor = &H00000000& DrawWidth = 4 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 13.5 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0000FF00& Height = 1335 Left = 0 ScaleHeight = 87 ScaleMode = 3 'Pixel ScaleWidth = 787 TabIndex = 0 Top = 0 Width = 11835 Begin VB.Frame Frame1 Height = 1335 Left = 0 TabIndex = 4 Top = 0 Width = 1755 Begin VB.CommandButton Command1 Caption = "&Exit" Height = 315 Left = 480 TabIndex = 5 Top = 960 Width = 675 End Begin VB.Label Label1 BackColor = &H00C0C0C0& Caption = "DOWN" BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 255 Index = 3 Left = 480 TabIndex = 9 Top = 660 Width = 675 End Begin VB.Label Label1 Caption = "RIGHT" BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 2 Left = 900 TabIndex = 8 Top = 420 Width = 675 End Begin VB.Label Label1 Caption = "LEFT" BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 1 Left = 120 TabIndex = 7 Top = 420 Width = 615 End Begin VB.Label Label1 Alignment = 2 'Center BackColor = &H00C0C0C0& Caption = "UP" BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 315 Index = 0 Left = 480 TabIndex = 6 Top = 180 Width = 615 End End End Attribute VB_Name = "Form1" Attribute VB_Creatable = False Attribute VB_Exposed = False Option Explicit Private Sub Command1_Click() Unload Me End Sub Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) Select Case KeyCode Case KEY_LEFT ' stars will scroll left. KeyStats = 1 Label1(0).ForeColor = &H404080 Label1(1).ForeColor = &HFF& Label1(2).ForeColor = &H404080 Label1(3).ForeColor = &H404080 Case KEY_UP KeyStats = 2 ' stars will scroll up. Label1(0).ForeColor = &HFF& Label1(1).ForeColor = &H404080 Label1(2).ForeColor = &H404080 Label1(3).ForeColor = &H404080 Case KEY_RIGHT KeyStats = 3 ' stars will scroll right. Label1(0).ForeColor = &H404080 Label1(1).ForeColor = &H404080 Label1(2).ForeColor = &HFF& Label1(3).ForeColor = &H404080 Case KEY_DOWN KeyStats = 4 ' stars will scroll down. Label1(0).ForeColor = &H404080 Label1(1).ForeColor = &H404080 Label1(2).ForeColor = &H404080 Label1(3).ForeColor = &HFF& End Select End Sub Private Sub Form_Load() 'set up the form Me.Height = Screen.Height Me.Width = Screen.Width Me.Top = 0 Me.Left = 0 'set up the work picutre box picWork.Top = 0 picWork.Left = 0 picWork.Height = Screen.Height picWork.Width = Screen.Width picWork.ScaleMode = 3 'set up the screen picutre box picScreen.Top = 0 picScreen.Left = 0 picScreen.Height = Me.Height picScreen.Width = Me.Width picScreen.ScaleMode = 3 ' set the number of stars in field Int_Star 'set the direction the stars will travel KeyStats = 1 'set the color of the label for which direction the stars will travel Label1(0).ForeColor = &H404080 Label1(1).ForeColor = &HFF& Label1(2).ForeColor = &H404080 Label1(3).ForeColor = &H404080 End Sub Public Sub Int_Star() Dim a As Integer ' used for FOR loop. Dim b As Integer ' used for ramdom star number. For a = 0 To NUMBER_STARS - 1 Randomize Timer ' get a random x,y position ' screen.height & screen.Width are in twips use / Screen.TwipsPerPixelX ' and / Screen.TwipsPerPixelY to get the pixels ( / = devide by ). tStar(a).x = ((Screen.Height / Screen.TwipsPerPixelX) * Rnd) + 1 tStar(a).y = ((Screen.Width / Screen.TwipsPerPixelY) * Rnd) + 1 ' pick a random number betwwen 1 - 3 b = 3 * Rnd + 1 If b = 1 Then tStar(a).color = &H808080 tStar(a).Speed = 5 ElseIf b = 2 Then tStar(a).color = &HC0C0C0 tStar(a).Speed = 10 Else tStar(a).color = &HC0C0& tStar(a).Speed = 15 End If Next End Sub Private Sub picScreen_DblClick() 'hmmmm you really are checking out this code :) ' reset the stars at ramdom postions and start scrolling again. Int_Star End Sub Private Sub Timer1_Timer() Dim rc As Integer Dim a As Integer picWork.Cls Select Case KeyStats Case 1 For a = 0 To NUMBER_STARS - 1 picWork.PSet (tStar(a).x, tStar(a).y), tStar(a).color tStar(a).x = tStar(a).x - tStar(a).Speed If tStar(a).x < 0 Then tStar(a).x = Screen.Width / Screen.TwipsPerPixelX Next Case 2 For a = 0 To NUMBER_STARS - 1 picWork.PSet (tStar(a).x, tStar(a).y), tStar(a).color tStar(a).y = tStar(a).y - tStar(a).Speed If tStar(a).y < 0 Then tStar(a).y = picWork.ScaleHeight Next Case 3 For a = 0 To NUMBER_STARS - 1 picWork.PSet (tStar(a).x, tStar(a).y), tStar(a).color tStar(a).x = tStar(a).x + tStar(a).Speed If tStar(a).x > Screen.Width / Screen.TwipsPerPixelX Then tStar(a).x = 0 Next Case 4 For a = 0 To NUMBER_STARS - 1 picWork.PSet (tStar(a).x, tStar(a).y), tStar(a).color tStar(a).y = tStar(a).y + tStar(a).Speed If tStar(a).y > picWork.ScaleHeight Then tStar(a).y = 0 Next End Select rc = BitBlt(picWork.hDC, 180, 180, picTitlemsk.ScaleWidth, picTitlemsk.ScaleHeight, picTitlemsk.hDC, 0, 0, SRCAND) rc = BitBlt(picWork.hDC, 180, 180, picTitle.ScaleWidth, picTitle.ScaleHeight, picTitle.hDC, 0, 0, SRCPAINT) picScreen.Cls rc = BitBlt(picScreen.hDC, 0, 0, picWork.ScaleWidth, picWork.ScaleWidth, picWork.hDC, 0, 0, SRCCOPY) End Sub